# ------------------------------------------------------------------------------
# Replication Materials
# 
# title: Eliciting Beliefs as Distributions in Online Surveys
# journal: Political Analysis
# authors: Lucas Leemann, Richard Traunmüller, and Lukas Stoetzer
# date: August 2020
# ------------------------------------------------------------------------------



creat_dat_Y <- function(dat, method ="Quantile", split.by=NULL){
  
  if(method == "Quantile"){
    
    if(is.null(split.by)){
      dat_return <- dat %>% 
        select(ResponseId,"median"=Q80,"lower"=Q95,"upper"=Q97) %>% # Select Median, Lower Quartile, Upper Quatile
        na.omit %>%
        mutate_at(c("median","lower","upper"),
                  funs(as.numeric(as.character(.))/100)) %>%
        mutate("check"=ifelse(lower<median & median < upper,1,0),
               "type" = "symmetric") %>%
        select(lower,median,upper) 
    } else {
      dat_return <- dat %>% 
        select(ResponseId,"median"=Q80,"lower"=Q95,"upper"=Q97) %>% # Select Median, Lower Quartile, Upper Quatile
        na.omit %>%
        mutate_at(c("median","lower","upper"),
                  funs(as.numeric(as.character(.))/100)) %>%
        mutate("check"=ifelse(lower<median & median < upper,1,0),
               "type" = "symmetric") %>%
        select(lower,median,upper) 
      
      
    }

    
  } else if(method == "QuantileNoCorrect"){
    
    dat_return <- dat %>% 
      select(ResponseId,"median"=Q37,"lower"=Q39,"upper"=Q41) %>% # Select Median, Lower Quartile, Upper Quatile
      na.omit %>%
      mutate_at(c("median","lower","upper"),
                funs(as.numeric(as.character(.))/100)) %>%
      mutate("check"=ifelse(lower<median & median < upper,1,0),
             "type" = "symmetric") %>%
      select(lower,median,upper) 
    
  } else if(method == "Interval"){
    
    dat_return <- dat %>% 
      select(ResponseId,ResponseId,"mean"=Q115,"lower.p"=Q116_1,"upper.p"=Q117_1) %>% # Select Median, Lower Quartile, Upper Quatile
      na.omit %>%
      mutate_at(c("mean","lower.p","upper.p"),
                funs(as.numeric(as.character(.))/100)) %>%
      select(mean,lower.p,upper.p) 
    
  } else if(method == "Interval2") {
    
    dat_return <- dat %>% 
      select(ResponseId,ResponseId,"mean"=Q132,"lower.p"=Q290_4,"upper.p"=Q291_1) %>% # Select Median, Lower prob, Upper prop
      na.omit %>%
      mutate_at(c("mean","lower.p","upper.p"),
                funs(as.numeric(as.character(.))/100)) %>%
      select(mean,lower.p,upper.p) 
    
    
    
  } else if(method == "Manski"){
    
    dat_return <- dat  %>% 
      select(ResponseId,ResponseId,"mean"=Q121,
             "lower"=Q122,"upper"=Q123,
             "lower.p"=Q125_1,"upper.p"=Q126_1) %>% # Select Median, Lower prob, Upper prop
      na.omit %>%
      mutate_at(c("mean","lower","upper","lower.p","upper.p"),
                funs(as.numeric(as.character(.))/100)) %>%
      select(mean,lower,upper,lower.p,upper.p) 
    
  } else if(method == "BinsBalls"){
    
    dat_return <- dat %>% 
      select(starts_with("q1_"))  %>% # Values
      na.omit %>%
      mutate_all(funs(as.numeric(as.character(.)))) 
    
  } else {
    
    stop("No Data Preparation for Method")
  }
  
  return(dat_return)
  
}



est_split_cov <- function(dat,m = "Quantile", tv = c(60,60), co=NULL) {
  
  dat <- dat %>%
    mutate(Uninv = ifelse(Q85=="University degree","Education_UniversityDegree","Education_NoUniversityDegree"),
           Female = ifelse(Q83=="Female","Gender_Female","Gender_Male"),
           Age = ifelse(as.numeric(as.character(Q84)<35),"Age_Below35","Age_Above35"),
           PolInt = ifelse(Q86 %in% c("Very interested"),
                           "PolInt_Very","PolInt_NotHardlyQuite")) 
  
  if(m== "Quantile"){
    est_uni <- lapply(split(dat, dat$Uninv), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta(true.val = tv)
    )
    
    est_fem <- lapply(split(dat, dat$Female), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta(true.val = tv)
    )
    
    est_age <- lapply(split(dat, dat$Age), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta(true.val = tv)
    )
    
    est_int <- lapply(split(dat, dat$PolInt), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta(true.val = tv)
    )
  } else if(m == "Interval"){
    
    est_uni <- lapply(split(dat, dat$Uninv), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_int(cut.offs = co, true.val = tv)
    )
    
    est_fem <- lapply(split(dat, dat$Female), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_int(cut.offs = co, true.val = tv)
    )
    
    est_age <- lapply(split(dat, dat$Age), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_int(cut.offs = co, true.val = tv)
    )
    
    est_int <- lapply(split(dat, dat$PolInt), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_int(cut.offs = co, true.val = tv)
    )
    
  } else if(m == "Interval2"){
    
    est_uni <- lapply(split(dat, dat$Uninv), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_int(cut.offs = co, true.val = tv)
    )
    
    est_fem <- lapply(split(dat, dat$Female), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_int(cut.offs = co, true.val = tv)
    )
    
    est_age <- lapply(split(dat, dat$Age), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_int(cut.offs = co, true.val = tv)
    )
    
    est_int <- lapply(split(dat, dat$PolInt), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_int(cut.offs = co, true.val = tv)
    )
    
  } else if(m == "Manski"){
    
    est_uni <- lapply(split(dat, dat$Uninv), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_manski(true.val = tv)
    )
    
    est_fem <- lapply(split(dat, dat$Female), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_manski(true.val = tv)
    )
    
    est_age <- lapply(split(dat, dat$Age), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_manski(true.val = tv)
    )
    
    est_int <- lapply(split(dat, dat$PolInt), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_manski(true.val = tv)
    )
    
  } else if(m == "BinsBalls"){
    
    est_uni <- lapply(split(dat, dat$Uninv), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_binsballs(true.val = tv)
    )
    
    est_fem <- lapply(split(dat, dat$Female), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_binsballs(true.val = tv)
    )
    
    est_age <- lapply(split(dat, dat$Age), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_binsballs(true.val = tv)
    )
    
    est_int <- lapply(split(dat, dat$PolInt), 
                      function(d) creat_dat_Y(d,method=m) %>%
                        est_eB_beta_binsballs(true.val = tv)
    )
    
  } else {
    
    stop("No Data Preparation for Method")
  }
    
    return(c(est_uni, est_fem,est_age,est_int))
  
}
